library(fpp2) # 시계열 분석을 위한 패키지
library(gridExtra)
theme_set(theme_grey(base_family='NanumGothic')) # ggplot 한글 깨짐 방지
options(scipen = 999) # to remove scientific notation
전체 스포츠 한 그림에
dir <- "/Users/jaeyonglee/Documents/College/RStudio/Culture/real_proper_ts_data/jeju/"
items <- c("골프","레저스포츠","스키","자전거","헬스")
# 데이터 불러오기
temp1 <- read.csv(paste(dir,items[1],".csv",sep=""), header=T)
temp2 <- read.csv(paste(dir,items[2],".csv",sep=""), header=T)
temp3 <- read.csv(paste(dir,items[3],".csv",sep=""), header=T)
temp4 <- read.csv(paste(dir,items[4],".csv",sep=""), header=T)
temp5 <- read.csv(paste(dir,items[5],".csv",sep=""), header=T)
# ts 개체로 만들기
temp1_ts <- ts(temp1['avg'][,1], start=2018, frequency=12) # [,1]은 univariate으로 정확히 해주기 위함임
temp2_ts <- ts(temp2['avg'][,1], start=2018, frequency=12)
temp3_ts <- ts(temp3['avg'][,1], start=2018, frequency=12)
temp4_ts <- ts(temp4['avg'][,1], start=2018, frequency=12)
temp5_ts <- ts(temp5['avg'][,1], start=2018, frequency=12)
# 시각화
temp_plot <- autoplot(temp1_ts, series = items[1]) +
autolayer(temp2_ts, series = items[2]) +
autolayer(temp3_ts, series = items[3]) +
autolayer(temp4_ts, series = items[4]) +
autolayer(temp5_ts, series = items[5]) +
labs(title = paste("스포츠 종목별 개인 취급액 시계열 (제주도)\n",sep=""),
caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수)",
x = "시간",
y = "취급액") +
labs(color='스포츠 종목 구분') +
theme(
plot.title = element_text(hjust = 0.5), # 가운데 정렬
plot.caption = element_text(hjust = 0) # 왼쪽 정렬
)
print(temp_plot)

스포츠 종목별 시계열 분해 및 예측
dir <- "/Users/jaeyonglee/Documents/College/RStudio/Culture/real_proper_ts_data/jeju/"
items <- c("전체 스포츠활동","골프","레저스포츠","스키","자전거","헬스")
for(item in items){
# 데이터 불러오기
if(item == "전체 스포츠활동"){
temp <- read.csv(paste(dir,"all_sports.csv",sep=""), header=T)
}else{
temp <- read.csv(paste(dir,item,".csv",sep=""), header=T)
}
# ts 개체로 만들기
temp_ts <- ts(temp['avg'][,1], start=2018, frequency=12) # [,1]은 univariate으로 정확히 해주기 위함임
# auto.arima로 최적의 pdq, PDQ 찾기
fit_arima <- auto.arima(temp_ts)
cat(paste(item,"의 개인 취급액 시계열 (제주도)\n", sep=""))
print(fit_arima)
# residual assumption 확인
checkresiduals(fit_arima)
fit_arima %>% forecast(h=12, level=80) %>% autoplot() +
labs(title = paste(item,"의 개인 취급액 시계열 (제주도)",sep=""),
subtitle = "미래 1~12개월(1년)에 대한 ARIMA의 예측치와 80% 신뢰구간",
caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수",
x = "시간",
y = "취급액") +
theme(
plot.title = element_text(hjust = 0.5), # 가운데 정렬
plot.subtitle = element_text(hjust = 0.5),
plot.caption = element_text(hjust = 0) # 왼쪽 정렬
) -> arima_plot
print(arima_plot)
# STL decomposition
fit_stl <- stl(temp_ts,s.window="periodic", robust=T)
autoplot(fit_stl) +
labs(title = paste(item,"의 개인 취급액 시계열 (제주도)",sep=""),
subtitle = "STL decomposition",
caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수)",
x = "시간",
y = "취급액") +
theme(
plot.title = element_text(hjust = 0.5), # 가운데 정렬
plot.subtitle = element_text(hjust = 0.5),
plot.caption = element_text(hjust = 0) # 왼쪽 정렬
) -> stl_plot
print(stl_plot)
}
전체 스포츠활동의 개인 취급액 시계열 (제주도)
Series: temp_ts
ARIMA(3,0,0)(1,1,0)[12]
Coefficients:
ar1 ar2 ar3 sar1
0.9174 -0.6418 0.5069 -0.6013
s.e. 0.1384 0.1731 0.1465 0.1226
sigma^2 = 38139878305104: log likelihood = -683.42
AIC=1376.84 AICc=1378.61 BIC=1385.29
Ljung-Box test
data: Residuals from ARIMA(3,0,0)(1,1,0)[12]
Q* = 3.8476, df = 6, p-value = 0.6973
Model df: 4. Total lags used: 10
골프의 개인 취급액 시계열 (제주도)
Series: temp_ts
ARIMA(1,0,0)(0,1,1)[12] with drift
Coefficients:
ar1 sma1 drift
0.4034 -0.8751 201982.49
s.e. 0.1571 0.9876 38722.27
sigma^2 = 7848227630458: log likelihood = -655.53
AIC=1319.05 AICc=1320.19 BIC=1325.81
Ljung-Box test
data: Residuals from ARIMA(1,0,0)(0,1,1)[12] with drift
Q* = 8.5157, df = 7, p-value = 0.2893
Model df: 3. Total lags used: 10
레저스포츠의 개인 취급액 시계열 (제주도)
Series: temp_ts
ARIMA(0,1,0)
sigma^2 = 5810972410099: log likelihood = -821.83
AIC=1645.66 AICc=1645.74 BIC=1647.59
Ljung-Box test
data: Residuals from ARIMA(0,1,0)
Q* = 29.107, df = 10, p-value = 0.001197
Model df: 0. Total lags used: 10
스키의 개인 취급액 시계열 (제주도)
Series: temp_ts
ARIMA(0,0,1)(0,1,0)[12]
Coefficients:
ma1
0.6389
s.e. 0.1365
sigma^2 = 398006152416: log likelihood = -561.16
AIC=1126.32 AICc=1126.66 BIC=1129.6
Ljung-Box test
data: Residuals from ARIMA(0,0,1)(0,1,0)[12]
Q* = 4.5406, df = 9, p-value = 0.8724
Model df: 1. Total lags used: 10
자전거의 개인 취급액 시계열 (제주도)
Series: temp_ts
ARIMA(0,1,1)(1,1,0)[12]
Coefficients:
ma1 sar1
-0.4194 -0.6210
s.e. 0.2056 0.1288
sigma^2 = 366147380719: log likelihood = -576.54
AIC=1159.09 AICc=1159.78 BIC=1164.08
Ljung-Box test
data: Residuals from ARIMA(0,1,1)(1,1,0)[12]
Q* = 12.132, df = 8, p-value = 0.1454
Model df: 2. Total lags used: 10
헬스의 개인 취급액 시계열 (제주도)
Series: temp_ts
ARIMA(0,1,1)
Coefficients:
ma1
-0.7282
s.e. 0.0987
sigma^2 = 4103411496642: log likelihood = -812.83
AIC=1629.66 AICc=1629.91 BIC=1633.53
Ljung-Box test
data: Residuals from ARIMA(0,1,1)
Q* = 5.4059, df = 9, p-value = 0.7976
Model df: 1. Total lags used: 10


















LS0tCnRpdGxlOiAi7Iqk7Y+s7Lig7Zmc64+ZIOyLnOqzhOyXtCDrtoTshJ0iCnN1YnRpdGxlOiAi7KCc7KO864+EIgphdXRob3I6ICLsnbTsnqzsmqkiCm91dHB1dDoKICBodG1sX25vdGVib29rOgogICAgdG9jOiB5ZXMKICAgIGNvZGVfZm9sZGluZzogImhpZGUiCi0tLQoKPHN0eWxlIHR5cGU9InRleHQvY3NzIj4KaDEudGl0bGUgewogIGZvbnQtc2l6ZTogMzBweDsKICB0ZXh0LWFsaWduOiBjZW50ZXI7Cn0KaDMuc3VidGl0bGUgewogIGZvbnQtc2l6ZTogMjBweDsKICB0ZXh0LWFsaWduOiBjZW50ZXI7Cn0KaDQuYXV0aG9yIHsgLyogSGVhZGVyIDQgLSBhbmQgdGhlIGF1dGhvciBhbmQgZGF0YSBoZWFkZXJzIHVzZSB0aGlzIHRvbyAgKi8KICAgIGZvbnQtc2l6ZTogMThweDsKICB0ZXh0LWFsaWduOiByaWdodDsKfQpib2R5ewogICBmb250LXNpemU6IDE3cHg7ICAjIGJvZHkgaXMgZm9yIG5vcm1hbCB0ZXh0Cn0KdGR7CiAgIGZvbnQtc2l6ZTogMTJweDsgICMgdGQgaXMgZm9yIHRhYmxlIGRhdGEKfQo8L3N0eWxlCgpcClwKXAoKYGBge3J9CmxpYnJhcnkoZnBwMikgICMg7Iuc6rOE7Je0IOu2hOyEneydhCDsnITtlZwg7Yyo7YKk7KeACmxpYnJhcnkoZ3JpZEV4dHJhKQp0aGVtZV9zZXQodGhlbWVfZ3JleShiYXNlX2ZhbWlseT0nTmFudW1Hb3RoaWMnKSkgICMgZ2dwbG90IO2VnOq4gCDquajsp5Ag67Cp7KeACm9wdGlvbnMoc2NpcGVuID0gOTk5KSAgIyB0byByZW1vdmUgc2NpZW50aWZpYyBub3RhdGlvbgpgYGAKClwKXAoKIyDsoITssrQg7Iqk7Y+s7LigIO2VnCDqt7jrprzsl5AKClwKCmBgYHtyfQpkaXIgPC0gIi9Vc2Vycy9qYWV5b25nbGVlL0RvY3VtZW50cy9Db2xsZWdlL1JTdHVkaW8vQ3VsdHVyZS9yZWFsX3Byb3Blcl90c19kYXRhL2planUvIgppdGVtcyA8LSBjKCLqs6jtlIQiLCLroIjsoIDsiqTtj6zsuKAiLCLsiqTtgqQiLCLsnpDsoITqsbAiLCLtl6zsiqQiKQoKIyDrjbDsnbTthLAg67aI65+s7Jik6riwCnRlbXAxIDwtIHJlYWQuY3N2KHBhc3RlKGRpcixpdGVtc1sxXSwiLmNzdiIsc2VwPSIiKSwgaGVhZGVyPVQpCnRlbXAyIDwtIHJlYWQuY3N2KHBhc3RlKGRpcixpdGVtc1syXSwiLmNzdiIsc2VwPSIiKSwgaGVhZGVyPVQpCnRlbXAzIDwtIHJlYWQuY3N2KHBhc3RlKGRpcixpdGVtc1szXSwiLmNzdiIsc2VwPSIiKSwgaGVhZGVyPVQpCnRlbXA0IDwtIHJlYWQuY3N2KHBhc3RlKGRpcixpdGVtc1s0XSwiLmNzdiIsc2VwPSIiKSwgaGVhZGVyPVQpCnRlbXA1IDwtIHJlYWQuY3N2KHBhc3RlKGRpcixpdGVtc1s1XSwiLmNzdiIsc2VwPSIiKSwgaGVhZGVyPVQpCgojIHRzIOqwnOyytOuhnCDrp4zrk6TquLAKdGVtcDFfdHMgPC0gdHModGVtcDFbJ2F2ZyddWywxXSwgc3RhcnQ9MjAxOCwgZnJlcXVlbmN5PTEyKSAgIyBbLDFd7J2AIHVuaXZhcmlhdGXsnLzroZwg7KCV7ZmV7Z6IIO2VtOyjvOq4sCDsnITtlajsnoQKdGVtcDJfdHMgPC0gdHModGVtcDJbJ2F2ZyddWywxXSwgc3RhcnQ9MjAxOCwgZnJlcXVlbmN5PTEyKQp0ZW1wM190cyA8LSB0cyh0ZW1wM1snYXZnJ11bLDFdLCBzdGFydD0yMDE4LCBmcmVxdWVuY3k9MTIpCnRlbXA0X3RzIDwtIHRzKHRlbXA0WydhdmcnXVssMV0sIHN0YXJ0PTIwMTgsIGZyZXF1ZW5jeT0xMikKdGVtcDVfdHMgPC0gdHModGVtcDVbJ2F2ZyddWywxXSwgc3RhcnQ9MjAxOCwgZnJlcXVlbmN5PTEyKQoKIyDsi5zqsIHtmZQKdGVtcF9wbG90IDwtIGF1dG9wbG90KHRlbXAxX3RzLCBzZXJpZXMgPSBpdGVtc1sxXSkgKwogIGF1dG9sYXllcih0ZW1wMl90cywgc2VyaWVzID0gaXRlbXNbMl0pICsKICBhdXRvbGF5ZXIodGVtcDNfdHMsIHNlcmllcyA9IGl0ZW1zWzNdKSArCiAgYXV0b2xheWVyKHRlbXA0X3RzLCBzZXJpZXMgPSBpdGVtc1s0XSkgKwogIGF1dG9sYXllcih0ZW1wNV90cywgc2VyaWVzID0gaXRlbXNbNV0pICsKICBsYWJzKHRpdGxlID0gcGFzdGUoIuyKpO2PrOy4oCDsooXrqqnrs4Qg6rCc7J24IOy3qOq4ieyVoSDsi5zqs4Tsl7QgKOygnOyjvOuPhClcbiIsc2VwPSIiKSwKICAgICAgIGNhcHRpb24gPSAiKOqwnOyduCDst6jquInslaEgPSDrj5nsnbwg64WE7JuU7J2YIOy3qOq4ieyVoeydmCDtlakgLyDsnbTsmqnqsbTsiJgpIiwKICAgICAgIHggPSAi7Iuc6rCEIiwKICAgICAgIHkgPSAi7Leo6riJ7JWhIikgKwogIGxhYnMoY29sb3I9J+yKpO2PrOy4oCDsooXrqqkg6rWs67aEJykgKwogIHRoZW1lKAogICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSksICMg6rCA7Jq0642wIOygleugrAogICAgcGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMCkgICMg7Jm87Kq9IOygleugrAogICAgKQpwcmludCh0ZW1wX3Bsb3QpCmBgYAoKXApcCgojIOyKpO2PrOy4oCDsooXrqqnrs4Qg7Iuc6rOE7Je0IOu2hO2VtCDrsI8g7JiI7LihCgpcCgpgYGB7cn0KZGlyIDwtICIvVXNlcnMvamFleW9uZ2xlZS9Eb2N1bWVudHMvQ29sbGVnZS9SU3R1ZGlvL0N1bHR1cmUvcmVhbF9wcm9wZXJfdHNfZGF0YS9qZWp1LyIKaXRlbXMgPC0gYygi7KCE7LK0IOyKpO2PrOy4oO2ZnOuPmSIsIuqzqO2UhCIsIuugiOyggOyKpO2PrOy4oCIsIuyKpO2CpCIsIuyekOyghOqxsCIsIu2XrOyKpCIpCgpmb3IoaXRlbSBpbiBpdGVtcyl7CiAgIyDrjbDsnbTthLAg67aI65+s7Jik6riwCiAgaWYoaXRlbSA9PSAi7KCE7LK0IOyKpO2PrOy4oO2ZnOuPmSIpewogICAgdGVtcCA8LSByZWFkLmNzdihwYXN0ZShkaXIsImFsbF9zcG9ydHMuY3N2IixzZXA9IiIpLCBoZWFkZXI9VCkKICB9ZWxzZXsKICAgIHRlbXAgPC0gcmVhZC5jc3YocGFzdGUoZGlyLGl0ZW0sIi5jc3YiLHNlcD0iIiksIGhlYWRlcj1UKQogIH0KICAKICAjIHRzIOqwnOyytOuhnCDrp4zrk6TquLAKICB0ZW1wX3RzIDwtIHRzKHRlbXBbJ2F2ZyddWywxXSwgc3RhcnQ9MjAxOCwgZnJlcXVlbmN5PTEyKSAgIyBbLDFd7J2AIHVuaXZhcmlhdGXsnLzroZwg7KCV7ZmV7Z6IIO2VtOyjvOq4sCDsnITtlajsnoQKCiAgIyBhdXRvLmFyaW1h66GcIOy1nOyggeydmCBwZHEsIFBEUSDssL7quLAKICBmaXRfYXJpbWEgPC0gYXV0by5hcmltYSh0ZW1wX3RzKQogIGNhdChwYXN0ZShpdGVtLCLsnZgg6rCc7J24IOy3qOq4ieyVoSDsi5zqs4Tsl7QgKOygnOyjvOuPhClcbiIsIHNlcD0iIikpCiAgcHJpbnQoZml0X2FyaW1hKQogIAogICMgcmVzaWR1YWwgYXNzdW1wdGlvbiDtmZXsnbgKICBjaGVja3Jlc2lkdWFscyhmaXRfYXJpbWEpCiAgCiAgZml0X2FyaW1hICU+JSBmb3JlY2FzdChoPTEyLCBsZXZlbD04MCkgJT4lIGF1dG9wbG90KCkgKwogICAgbGFicyh0aXRsZSA9IHBhc3RlKGl0ZW0sIuydmCDqsJzsnbgg7Leo6riJ7JWhIOyLnOqzhOyXtCAo7KCc7KO864+EKSIsc2VwPSIiKSwKICAgICAgICAgc3VidGl0bGUgPSAi66+4656YIDF+MTLqsJzsm5QoMeuFhCnsl5Ag64yA7ZWcIEFSSU1B7J2YIOyYiOy4oey5mOyZgCA4MCUg7Iug66Kw6rWs6rCEIiwKICAgICAgICAgY2FwdGlvbiA9ICIo6rCc7J24IOy3qOq4ieyVoSA9IOuPmeydvCDrhYTsm5TsnZgg7Leo6riJ7JWh7J2YIO2VqSAvIOydtOyaqeqxtOyImCIsCiAgICAgICAgIHggPSAi7Iuc6rCEIiwKICAgICAgICAgeSA9ICLst6jquInslaEiKSArCiAgICB0aGVtZSgKICAgICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSksICMg6rCA7Jq0642wIOygleugrAogICAgICBwbG90LnN1YnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMC41KSwKICAgICAgcGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMCkgICMg7Jm87Kq9IOygleugrAogICAgICApIC0+IGFyaW1hX3Bsb3QKICBwcmludChhcmltYV9wbG90KQogIAogICMgU1RMIGRlY29tcG9zaXRpb24KICBmaXRfc3RsIDwtIHN0bCh0ZW1wX3RzLHMud2luZG93PSJwZXJpb2RpYyIsIHJvYnVzdD1UKQogIGF1dG9wbG90KGZpdF9zdGwpICsKICAgIGxhYnModGl0bGUgPSBwYXN0ZShpdGVtLCLsnZgg6rCc7J24IOy3qOq4ieyVoSDsi5zqs4Tsl7QgKOygnOyjvOuPhCkiLHNlcD0iIiksCiAgICAgICAgIHN1YnRpdGxlID0gIlNUTCBkZWNvbXBvc2l0aW9uIiwKICAgICAgICAgY2FwdGlvbiA9ICIo6rCc7J24IOy3qOq4ieyVoSA9IOuPmeydvCDrhYTsm5TsnZgg7Leo6riJ7JWh7J2YIO2VqSAvIOydtOyaqeqxtOyImCkiLAogICAgICAgICB4ID0gIuyLnOqwhCIsCiAgICAgICAgIHkgPSAi7Leo6riJ7JWhIikgKwogICAgdGhlbWUoCiAgICAgIHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAwLjUpLCAjIOqwgOyatOuNsCDsoJXroKwKICAgICAgcGxvdC5zdWJ0aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSksCiAgICAgIHBsb3QuY2FwdGlvbiA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDApICAjIOyZvOyqvSDsoJXroKwKICAgICAgKSAtPiBzdGxfcGxvdAogIHByaW50KHN0bF9wbG90KQp9CmBgYAoKXApcClwKCgoK